@@ -1,5 +1,17 @@
Devel::Cover.pm history
+Release 0.77 - 15th May 2011
+ - Fix cover -test covering all the test files (Larry Leszczynski) (rt 65920).
+ - Add DEVEL_COVER_IO_OPTIONS environment variable.
+ - Sort runs by start time.
+ - Add digests to DB.
+ - Add cover -make option (Olivier Mengué) (rt 44906).
+ - Add digests to DB.
+ This should fix some problems related to losing coverage data when there are
+ duplicate files. This happens most usually when modules are sometimes loaded
+ from lib and sometimes from blib. (rt 14192, 32465, 45737).
+ - Add branch coverage for gcov (rt 30365).
+
Release 0.76 - 18th April 2011
- Move CHANGES file into root for search.cpan.org (rt 67541).
- Add top level version subroutine (requested by H.Merijn Brand).
@@ -14,7 +26,7 @@ Release 0.75 - 17th April 2011
Release 0.74 - 16th April 2011
- Test against 5.12.3 and code frozen 5.14.0 (unreleased).
- - Fix tests to work with all releases of 5.13.x (rt 60901).
+ - Fix tests to work with all releases of 5.13.x (rt 64210, 60901).
- Avoid race condition writing DB structure files (Nicholas Clark).
- Add debuglog method to Devel::Cover::DB::Structure (Nicholas Clark).
- Be more careful deleting DB structure files (Nicholas Clark).
@@ -1434,6 +1434,11 @@ BOOT:
initialise(aTHX);
if (MY_CXT.replace_ops) {
replace_ops(aTHX);
+#if defined HAS_GETTIMEOFDAY
+ elapsed();
+#elif defined HAS_TIMES
+ cpu();
+#endif
}
else {
PL_runops = runops_cover;
@@ -20,8 +20,11 @@ lib/Devel/Cover/Condition_or_3.pm
lib/Devel/Cover/Condition_xor_4.pm
lib/Devel/Cover/Criterion.pm
lib/Devel/Cover/DB.pm
+lib/Devel/Cover/DB/Digests.pm
lib/Devel/Cover/DB/File.pm
lib/Devel/Cover/DB/IO.pm
+lib/Devel/Cover/DB/IO/JSON.pm
+lib/Devel/Cover/DB/IO/Storable.pm
lib/Devel/Cover/DB/Structure.pm
lib/Devel/Cover/Op.pm
lib/Devel/Cover/Pod.pm
@@ -46,6 +49,7 @@ MANIFEST.SKIP
META.yml
README
t/internal/criteria.t
+t/internal/subprocess.t
t/regexp/regexp_eval.t
tests/.uncoverable
tests/alias
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Devel-Cover
-version: 0.76
+version: 0.77
abstract: Code coverage metrics for Perl
author:
- Paul Johnson (pjcj@cpan.org)
@@ -19,8 +19,8 @@ use File::Copy;
$| = 1;
-my $Version = "0.76";
-my $Date = "18th April 2011";
+my $Version = "0.77";
+my $Date = "15th May 2011";
my $Author = 'pjcj@cpan.org';
my @perlbug = ("perlbug", "-a", $Author,
@@ -260,7 +260,7 @@ consider installing Test::Differences. You can download
Test::Differences from CPAN.
EOM
-my $latest_tested = "5.012003";
+my $latest_tested = "5.014000";
print <<EOM if $] > $latest_tested;
Devel::Cover $Version has not been tested with perl $].
@@ -276,7 +276,7 @@ if ($] < 5.008)
Devel::Cover $Version is not fully functional on perl $]. It should
mostly work, but there are some constructs for which coverage will not
be collected, and you may well encounter bugs which have been fixed in
-subsequent versions of perl. Perl versions 5.8.1 and above should work
+subsequent versions of perl. Perl versions 5.8.8 and above should work
better.
EOM
@@ -12,19 +12,20 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::DB 0.76;
+use Devel::Cover::DB 0.77;
use Config;
use File::Spec;
-use Data::Dumper;
use File::Find ();
use File::Path;
use FindBin '$Bin';
use Getopt::Long;
use Pod::Usage;
+use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1;
+
my $Options =
{
add_uncoverable_point => [],
@@ -35,6 +36,7 @@ my $Options =
gcov => $Config{gccversion},
ignore => [],
ignore_re => [],
+ make => $Config{make},
select => [],
select_re => [],
report => "",
@@ -64,6 +66,7 @@ sub get_options
ignore_re=s
ignore=s
info|i!
+ make=s
outputdir=s
report=s
select_re=s
@@ -96,20 +99,20 @@ sub delete_db
}
# Decide whether to run ./Build test or make test
-sub test_command { -e "Build.PL" ? mb_test_command() : mm_test_command() }
+sub test_command { -e "Build" ? mb_test_command() : mm_test_command() }
# Compiler arguments necessary to do a coverage run
-sub gcov_args { "-fprofile-arcs\\ -ftest-coverage" }
+sub gcov_args() { "-fprofile-arcs -ftest-coverage" }
# Test command for MakeMaker
sub mm_test_command
{
- my $test = "make test";
+ my $test = "$Options->{make} test";
if ($Options->{gcov})
{
my $o = gcov_args();
- $test .= " OPTIMIZE=-O0\\ $o OTHERLDFLAGS=$o";
+ $test .= qq{ "OPTIMIZE=-O0 $o" "OTHERLDFLAGS=$o"};
}
$test
@@ -123,7 +126,7 @@ sub mb_test_command
if ($Options->{gcov})
{
my $o = gcov_args();
- $test .= " --extra_compiler_flags=-O0\\ $o --extra_linker_flags=$o";
+ $test .= qq{ "--extra_compiler_flags=-O0 $o" "--extra_linker_flags=$o"};
}
$test
@@ -201,7 +204,7 @@ sub main
# system "$^X Makefile.PL" unless -e "Makefile";
delete_db($dbname, @ARGV);
local $ENV{ -d "t" ? "HARNESS_PERL_SWITCHES" : "PERL5OPT" } =
- "-MDevel::Cover=-db,$dbname";
+ "$ENV{DEVEL_COVER_TEST_OPTS} -MDevel::Cover=-db,$dbname";
my $test = test_command();
@@ -231,7 +234,7 @@ sub main
$graph_file =~ s{\.\w+$}{.gcno};
return unless -e $graph_file;
- my $c = "gcov $name";
+ my $c = "gcov -abc -o $File::Find::dir $name";
print STDERR "cover: running $c\n";
system $c;
};
@@ -313,8 +316,6 @@ sub main
return unless length $Options->{report};
- # use Data::Dumper; $Data::Dumper::Indent = 1; print Dumper $db->cover;
-
# TODO - The sense of select and ignore should be reversed to match
# collection.
@@ -360,6 +361,7 @@ cover - report coverage statistics
-silent
-coverage criterion
-test -gcov
+ -make [make]
-add_uncoverable_point -delete_uncoverable_point
-clean_uncoverable_points -uncoverable_file
[report specific options]
@@ -402,6 +404,7 @@ The following command line options are supported:
-test - drop database(s) and run make test (default off)
-gcov - run gcov to cover XS code (default on if using gcc)
+ -make make_prog - use the given 'make' program for 'make test'
other options specific to the report
@@ -446,7 +449,7 @@ See the BUGS file.
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::DB 0.76;
+use Devel::Cover::DB 0.77;
use Cwd ();
use Getopt::Long;
@@ -22,6 +22,8 @@ use Pod::Usage;
use Template 2.00;
use Parallel::Iterator "iterate_as_array";
+use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1;
+
# use Carp; $SIG{__DIE__} = \&Carp::confess;
my $Template;
@@ -314,8 +316,6 @@ sub write_html
}
}
- # use Data::Dumper; print Dumper $vars;
-
write_stylesheet;
$Template->process("summary", $vars, $f) or die $Template->error();
@@ -344,7 +344,7 @@ sub main
sub { get_cover $_[1] },
$Options->{module}
);
- use Data::Dumper; print Dumper \@res;
+ print Dumper \@res;
# get_cover($_) for @{$Options->{module}};
}
@@ -356,7 +356,7 @@ package Devel::Cover::Cpancover::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Template::Provider";
@@ -393,7 +393,7 @@ $Templates{html} = <<'EOT';
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<!--
-This file was generated by Devel::Cover Version 0.76
+This file was generated by Devel::Cover Version 0.77
Devel::Cover is copyright 2001-2011, Paul Johnson (pjcj\@cpan.org)
Devel::Cover is free. It is licensed under the same terms as Perl itself.
The latest version of Devel::Cover should be available from my homepage:
@@ -494,7 +494,7 @@ The following exit values are returned:
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -5,7 +5,7 @@
$ git diff
$ git commit -v MANIFEST
- 3. Update docs/CHANGES.
+ 3. Update CHANGES.
- Show the release number and date of release.
- Add important changes.
- Credit the author as appropriate.
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::DB 0.76;
+use Devel::Cover::DB 0.77;
use File::Path;
use File::Spec;
@@ -54,13 +54,21 @@ sub add_cover
my %run;
$run{collected} = ["statement"];
+ $run{start} = $run{finish} = time;
my $structure = Devel::Cover::DB::Structure->new;
$structure->add_criteria("statement");
+ $structure->add_criteria("branch");
+
+ my $statement_re = qr/^\s*([-0-9#]+):\s*(\d+):(.*)/;
+ my $branch_re = qr/^branch\s+(\d+)\s+(?:taken|never)\s+(\w+)/;
+
+ my ($line, $text);
open F, $file or die "Can't open $file: $!\n";
- while (<F>)
+ gcov_line: while (my $gcov_text = <F>)
{
- if (/^[^:]+:[^:]+:Source:(.*)$/)
+ # print "Processing line [$gcov_text]\n";
+ if ($gcov_text =~ /^[^:]+:[^:]+:Source:(.*)$/)
{
$f = $1;
$f = File::Spec->abs2rel(File::Spec->catfile($dir, $f))
@@ -76,17 +84,50 @@ sub add_cover
}
$run{digests}{$f} = $structure->set_file($f);
}
- next unless my ($count, $line) = /^\s*([-0-9#]+):\s*(\d+):/;
- next if $count eq "-";
- $count = 0 if $count eq "#####";
+ if ($gcov_text =~ $statement_re)
+ {
+ my $count = $1;
+ $line = $2;
+ $text = $3;
+
+ next if $count eq "-";
+ $count = 0 if $count eq "#####";
+
+ # print "$f:$line - $count\n";
+ push @{$run{count}{$f}{statement}}, $count;
+ $structure->add_statement($f, $line);
+ }
+ elsif ($gcov_text =~ $branch_re)
+ {
+ my @branches;
+ # look for:
+ # branch 0 taken 0 (fallthrough)
+ # branch 1 taken 19
+ # branch 0 never executed
+ # branch 1 never executed
+ while ($gcov_text =~ $branch_re)
+ {
+ push @branches, $2 eq "executed" ? 0 : $2;
+ $gcov_text = <F>;
+ }
+ # print "branches on $f:$line are: @branches\n";
- # print "$f:$line - $count\n";
- push @{$run{count}{$f}{statement}}, $count;
- $structure->add_statement($f, $line);
+ if (@branches == 2)
+ {
+ $structure->add_branch($f, [ $line, { text => $text } ]);
+ push @{$run{count}{$f}{branch}}, \@branches;
+ }
+ else
+ {
+ warn "gcov2perl: Warning: ignoring branch with ",
+ scalar @branches, " targets at $f:$line $text\n";
+ }
+ redo gcov_line; # process the line after the branch data
+ }
}
close F or die "Can't close $file: $!\n";
- my $run = time . ".$$." . sprintf "%05d", rand 2 ** 16;
+ my $run = $run{start} . ".$$." . sprintf "%05d", rand 2 ** 16;
my $db = $Options->{db};
my $cover = Devel::Cover::DB->new
(
@@ -185,7 +226,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Annotation::Git;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use Getopt::Long;
@@ -153,7 +153,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Annotation::Random;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use Getopt::Long;
@@ -103,7 +103,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Annotation::Svk;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use Getopt::Long;
use Digest::MD5;
@@ -175,7 +175,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Branch;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Criterion";
@@ -88,7 +88,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Branch";
@@ -50,7 +50,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_and_2;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_and_3;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_or_2;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_or_3;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_xor_4;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Condition";
@@ -45,7 +45,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,19 +10,19 @@ package Devel::Cover::Criterion;
use strict;
use warnings;
-our $VERSION = "0.76";
-
-use Devel::Cover::Statement 0.76;
-use Devel::Cover::Branch 0.76;
-use Devel::Cover::Condition 0.76;
-use Devel::Cover::Condition_or_2 0.76;
-use Devel::Cover::Condition_or_3 0.76;
-use Devel::Cover::Condition_and_2 0.76;
-use Devel::Cover::Condition_and_3 0.76;
-use Devel::Cover::Condition_xor_4 0.76;
-use Devel::Cover::Subroutine 0.76;
-use Devel::Cover::Time 0.76;
-use Devel::Cover::Pod 0.76;
+our $VERSION = "0.77";
+
+use Devel::Cover::Statement 0.77;
+use Devel::Cover::Branch 0.77;
+use Devel::Cover::Condition 0.77;
+use Devel::Cover::Condition_or_2 0.77;
+use Devel::Cover::Condition_or_3 0.77;
+use Devel::Cover::Condition_and_2 0.77;
+use Devel::Cover::Condition_and_3 0.77;
+use Devel::Cover::Condition_xor_4 0.77;
+use Devel::Cover::Subroutine 0.77;
+use Devel::Cover::Time 0.77;
+use Devel::Cover::Pod 0.77;
sub coverage { $_[0][0] }
sub information { $_[0][1] }
@@ -97,7 +97,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -0,0 +1,154 @@
+# Copyright 2011, Paul Johnson (pjcj@cpan.org)
+
+# This software is free. It is licensed under the same terms as Perl itself.
+
+# The latest version of this software should be available from my homepage:
+# http://www.pjcj.net
+
+package Devel::Cover::DB::Digests;
+
+use strict;
+use warnings;
+
+our $VERSION = "0.77";
+
+use Devel::Cover::DB::Structure 0.77;
+use Devel::Cover::DB::IO 0.77;
+
+my $File = "digests";
+
+sub new
+{
+ my $class = shift;
+ my $self =
+ {
+ digests => {},
+ @_
+ };
+
+ die "No db specified" unless $self->{db};
+ $self->{file} = "$self->{db}/$File";
+
+ bless $self, $class;
+ $self->read;
+ $self
+}
+
+sub read
+{
+ my $self = shift;
+ my $io = Devel::Cover::DB::IO->new;
+ $self->{digests} = $io->read($self->{file}) if -e $self->{file};
+ $self
+}
+
+sub write
+{
+ my $self = shift;
+ my $io = Devel::Cover::DB::IO->new;
+ $io->write($self->{digests}, $self->{file});
+ $self
+}
+
+sub get
+{
+ my $self = shift;
+ my ($digest) = @_;
+ $self->{digests}{$digest}
+}
+
+sub set
+{
+ my $self = shift;
+ my ($file, $digest) = @_;
+ $self->{digests}{$digest} = $file;
+}
+
+sub canonical_file
+{
+ my $self = shift;
+ my ($file) = @_;
+
+ my $cfile = $file;
+ my $digest = Devel::Cover::DB::Structure->digest($file);
+ if ($digest)
+ {
+ my $dfile = $self->get($digest);
+ if ($dfile && $dfile ne $file)
+ {
+ warn "Devel::Cover: Adding coverage for $file to $dfile\n"
+ unless $Devel::Cover::Silent;
+ $cfile = $dfile;
+ }
+ else
+ {
+ $self->set($file, $digest);
+ }
+ }
+
+ # warn "[$file] => [$cfile]\n";
+
+ $cfile
+}
+
+1
+
+__END__
+
+=head1 NAME
+
+Devel::Cover::DB::Digests - store digests for Devel::Cover::DB
+
+=head1 SYNOPSIS
+
+ use Devel::Cover::DB::Digests;
+ my $digests = Devel::Cover::DB::Digests->new(db => $DB);
+ $digests->read;
+ $digests->write;
+
+=head1 DESCRIPTION
+
+This module stores digests for Devel::Cover::DB.
+
+=head1 SEE ALSO
+
+ Devel::Cover
+
+=head1 METHODS
+
+=head2 new
+
+ my $digests = Devel::Cover::DB::Digests->new(db => $DB);
+
+Contructs the digests object.
+
+=head2 read
+
+ $digests->read;
+
+Read the digests from the DB.
+
+=head2 write
+
+ $digests->write;
+
+Write the digests to the DB.
+
+=head1 BUGS
+
+Huh?
+
+=head1 VERSION
+
+Version 0.77 - 15th May 2011
+
+=head1 LICENCE
+
+Copyright 2001-2011, Paul Johnson (pjcj@cpan.org)
+
+This software is free. It is licensed under the same terms as Perl itself.
+
+The latest version of this software should be available from my homepage:
+http://www.pjcj.net
+
+=cut
@@ -10,9 +10,11 @@ package Devel::Cover::DB::File;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::Criterion 0.76;
+use Devel::Cover::Criterion 0.77;
+
+use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1;
sub calculate_summary
{
@@ -39,7 +41,7 @@ sub calculate_percentage
my $self = shift;
my ($db, $s) = @_;
- # use Data::Dumper; print STDERR Dumper $s;
+ # print STDERR Dumper $s;
for my $criterion ($self->items)
{
@@ -50,7 +52,7 @@ sub calculate_percentage
}
Devel::Cover::Criterion->calculate_percentage($db, $s->{total});
- # use Data::Dumper; print STDERR Dumper $s;
+ # print STDERR Dumper $s;
}
1
@@ -79,7 +81,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -0,0 +1,113 @@
+# Copyright 2011, Paul Johnson (pjcj@cpan.org)
+
+# This software is free. It is licensed under the same terms as Perl itself.
+
+# The latest version of this software should be available from my homepage:
+# http://www.pjcj.net
+
+package Devel::Cover::DB::IO::JSON;
+
+use strict;
+use warnings;
+
+use Fcntl ":flock";
+use JSON::PP;
+
+our $VERSION = "0.77";
+
+sub new
+{
+ my $class = shift;
+ my $self = { @_ };
+ bless $self, $class
+}
+
+sub read
+{
+ my $self = shift;
+ my ($file) = @_;
+
+ open my $fh, "<", $file or die "Can't open $file: $!";
+ flock($fh, LOCK_SH) or die "Cannot lock file: $!\n";
+ local $/;
+ my $data = JSON::PP::decode_json(<$fh>);
+ close $fh or die "Can't close $file: $!";
+ $data
+}
+
+sub write
+{
+ my $self = shift;
+ my ($data, $file) = @_;
+
+ my $json = JSON::PP->new->utf8;
+ $json->ascii->pretty->canonical if $self->{options} =~ /\bpretty\b/i;
+ open my $fh, ">", $file or die "Can't open $file: $!";
+ flock($fh, LOCK_EX) or die "Cannot lock file: $!\n";
+ print $fh $json->encode($data);
+ close $fh or die "Can't close $file: $!";
+ $self
+}
+
+1
+
+__END__
+
+=head1 NAME
+
+Devel::Cover::DB::IO::JSON - JSON based IO routines for Devel::Cover::DB
+
+=head1 SYNOPSIS
+
+ use Devel::Cover::DB::IO::JSON;
+
+ my $io = Devel::Cover::DB::IO::JSON->new;
+ my $data = $io->read($file);
+ $io->write($data, $file);
+
+=head1 DESCRIPTION
+
+This module provides JSON based IO routines for Devel::Cover::DB.
+
+=head1 SEE ALSO
+
+ Devel::Cover
+
+=head1 METHODS
+
+=head2 new
+
+ my $io = Devel::Cover::DB::IO::JSON->new;
+
+Contructs the IO object.
+
+=head2 read
+
+ my $data = $io->read($file);
+
+Returns a perl data structure representingthe data read from $file.
+
+=head2 write
+
+ $io->write($data, $file);
+
+Writes $data to $file in the format specified when creating $io.
+
+=head1 BUGS
+
+Huh?
+
+=head1 VERSION
+
+Version 0.77 - 15th May 2011
+
+=head1 LICENCE
+
+Copyright 2001-2011, Paul Johnson (pjcj@cpan.org)
+
+This software is free. It is licensed under the same terms as Perl itself.
+
+The latest version of this software should be available from my homepage:
+http://www.pjcj.net
+
+=cut
@@ -0,0 +1,102 @@
+# Copyright 2011, Paul Johnson (pjcj@cpan.org)
+
+# This software is free. It is licensed under the same terms as Perl itself.
+
+# The latest version of this software should be available from my homepage:
+# http://www.pjcj.net
+
+package Devel::Cover::DB::IO::Storable;
+
+use strict;
+use warnings;
+
+use Storable;
+
+our $VERSION = "0.77";
+
+sub new
+{
+ my $class = shift;
+ my $self = { @_ };
+ bless $self, $class
+}
+
+sub read
+{
+ my $self = shift;
+ my ($file) = @_;
+
+ Storable::lock_retrieve($file)
+}
+
+sub write
+{
+ my $self = shift;
+ my ($data, $file) = @_;
+
+ Storable::lock_nstore($data, $file);
+ $self
+}
+
+1
+
+__END__
+
+=head1 NAME
+
+Devel::Cover::DB::IO::Storable - Storable based IO routines for Devel::Cover::DB
+
+=head1 SYNOPSIS
+
+ use Devel::Cover::DB::IO::Storable;
+
+ my $io = Devel::Cover::DB::IO::Storable->new;
+ my $data = $io->read($file);
+ $io->write($data, $file);
+
+=head1 DESCRIPTION
+
+This module provides Storable based IO routines for Devel::Cover::DB.
+
+=head1 SEE ALSO
+
+ Devel::Cover
+
+=head1 METHODS
+
+=head2 new
+
+ my $io = Devel::Cover::DB::IO::Storable->new;
+
+Contructs the IO object.
+
+=head2 read
+
+ my $data = $io->read($file);
+
+Returns a perl data structure representingthe data read from $file.
+
+=head2 write
+
+ $io->write($data, $file);
+
+Writes $data to $file in the format specified when creating $io.
+
+=head1 BUGS
+
+Huh?
+
+=head1 VERSION
+
+Version 0.77 - 15th May 2011
+
+=head1 LICENCE
+
+Copyright 2001-2011, Paul Johnson (pjcj@cpan.org)
+
+This software is free. It is licensed under the same terms as Perl itself.
+
+The latest version of this software should be available from my homepage:
+http://www.pjcj.net
+
+=cut
@@ -10,77 +10,31 @@ package Devel::Cover::DB::IO;
use strict;
use warnings;
-use Fcntl ":flock";
-
-our $VERSION = "0.76";
+our $VERSION = "0.77";
my $Format;
BEGIN
{
- $Format = $ENV{DEVEL_COVER_DB_FORMAT} ||
- (eval { require JSON::PP; 1 } ? "JSON" : "Storable");
+ $Format = "Storable" if eval "use Storable; 1";
+ # warn "Storable available\n" if $INC{"Storable.pm"};
+ $Format = "JSON" if eval "use JSON::PP; 1";
+ # warn "JSON::PP available\n" if $INC{"JSON/PP.pm"};
+ die "Can't load either JSON::PP or Storable" unless $Format;
}
sub new
{
my $class = shift;
- my $self =
- {
- format => $Format,
- @_
- };
-
- if ($self->{format} eq "Storable")
- {
- require Storable;
- }
- elsif ($self->{format} eq "JSON")
- {
- require JSON::PP;
- }
- else
- {
- die "Devel::Cover: Unrecognised DB format: $self->{format}";
- }
-
- bless $self, $class
-}
-sub read
-{
- my $self = shift;
- my ($file) = @_;
-
- if ($self->{format} eq "Storable")
- {
- return Storable::lock_retrieve($file);
- }
-
- open my $fh, "<", $file or die "Can't open $file: $!";
- flock($fh, LOCK_SH) or die "Cannot lock mailbox - $!\n";
- local $/;
- my $data = JSON::PP::decode_json(<$fh>);
- close $fh or die "Can't close $file: $!";
- $data
-}
+ my $format = $ENV{DEVEL_COVER_DB_FORMAT} || $Format;
+ die "Devel::Cover: Unrecognised DB format: $format"
+ unless $format =~ /^(?:Storable|JSON)$/;
-sub write
-{
- my $self = shift;
- my ($data, $file) = @_;
-
- if ($self->{format} eq "Storable")
- {
- Storable::lock_nstore($data, $file);
- return $self;
- }
-
- open my $fh, ">", $file or die "Can't open $file: $!";
- flock($fh, LOCK_EX) or die "Cannot lock mailbox - $!\n";
- print $fh "", JSON::PP::encode_json($data); # "", for 5.6.1
- close $fh or die "Can't close $file: $!";
- $self
+ $class .= "::$format";
+ eval "use $class; 1" or die "Devel::Cover: $@";
+
+ $class->new(options => $ENV{DEVEL_COVER_IO_OPTIONS} || "", @_)
}
1
@@ -133,7 +87,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -14,12 +14,14 @@ use Carp;
use Digest::MD5;
use Devel::Cover::DB;
-use Devel::Cover::DB::IO 0.76;
+use Devel::Cover::DB::IO 0.77;
+
+use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1;
# For comprehensive debug logging.
use constant DEBUG => 0;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
our $AUTOLOAD;
sub new
@@ -60,12 +62,14 @@ sub AUTOLOAD
{
*$func = sub
{
- my $self = shift;
- my $file = shift;
- # print STDERR "file: $file, condition: $c\n";
- # TODO - why no file?
- return unless defined $file;
- $self->{f}{$file}{$c}
+ my $self = shift;
+ my $digest = shift;
+ # print STDERR "file: $digest, condition: $c\n";
+ for my $fval (values %{$self->{f}})
+ {
+ return $fval->{$c} if $fval->{digest} eq $digest;
+ }
+ return
}
};
}
@@ -89,8 +93,6 @@ sub debuglog {
mkdir $dir, 0700 or confess "Can't mkdir $dir: $!";
}
- require Data::Dumper;
- local $Data::Dumper::Indent = 1;
local $\;
# One log file per process, as we're potentially dumping out large amounts,
# and might excede the atomic write size of the OS.
@@ -127,7 +129,6 @@ sub set_subroutine
# for when there are multiple subroutines of the same name on the same
# line (such subroutines generally being called BEGIN).
- # use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1;
# print STDERR "set_subroutine start $file:$line $sub_name($scount) ",
# Dumper $self->{f}{$file}{start};
$self->{additional} = 0;
@@ -188,7 +189,6 @@ sub store_counts
$self->{f}{$file}{start}{-1}{__COVER__}[0]{$_} =
$self->get_count($_)
for $self->criteria;
- # use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1;
# print STDERR Dumper $self->{f}{$file}{start};
}
@@ -268,7 +268,7 @@ sub write
{
my $self = shift;
my ($dir) = @_;
- # use Data::Dumper; print STDERR Dumper $self;
+ # print STDERR Dumper $self;
$dir .= "/structure";
unless (-d $dir)
{
@@ -331,7 +331,7 @@ sub read
}
}
my $d = $self->digest($s->{file});
- # use Data::Dumper; print STDERR "reading $digest from $file: ", Dumper $s;
+ # print STDERR "reading $digest from $file: ", Dumper $s;
if (!$d) {
# No digest implies that we can't read the file. Likely this is because
# it's stored with a relative path. In which case, it's not valid to
@@ -402,7 +402,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,16 +10,18 @@ package Devel::Cover::DB;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::Criterion 0.76;
-use Devel::Cover::DB::File 0.76;
-use Devel::Cover::DB::Structure 0.76;
-use Devel::Cover::DB::IO 0.76;
+use Devel::Cover::Criterion 0.77;
+use Devel::Cover::DB::File 0.77;
+use Devel::Cover::DB::Structure 0.77;
+use Devel::Cover::DB::IO 0.77;
use Carp;
use File::Path;
+use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1;
+
my $DB = "cover.13"; # Version 13 of the database.
@Devel::Cover::DB::Criteria =
@@ -27,8 +29,6 @@ my $DB = "cover.13"; # Version 13 of the database.
@Devel::Cover::DB::Criteria_short =
(qw( stmt bran path cond sub pod time ));
-# use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1;
-
sub new
{
my $class = shift;
@@ -187,9 +187,9 @@ sub is_valid
for my $file (readdir $fh)
{
next if $file eq "." || $file eq "..";
- next if ($file eq "runs" || $file eq "structure" || $file eq "debuglog")
+ next if $file =~ /(?:runs|structure|debuglog|digests)$/
&& -e "$self->{db}/$file";
- # warn "found $file in $self->{db}";
+ warn "found $file in $self->{db}";
return 0;
}
closedir $fh
@@ -206,7 +206,6 @@ sub merge
{
my ($self, $from) = @_;
- # use Data::Dumper; $Data::Dumper::Indent = 1;
# print STDERR "Merging ", Dumper($self), "From ", Dumper($from);
while (my ($fname, $frun) = each %{$from->{runs}})
@@ -352,7 +351,7 @@ sub calculate_summary
$self->cover->get($file)->calculate_summary($self, $file, \%options);
}
- # use Data::Dumper; print STDERR Dumper $self;
+ # print STDERR Dumper $self;
for my $file ($self->cover->items)
{
@@ -447,8 +446,8 @@ sub add_statement
$cc->{$l}[$n][0] += $fc->[$i];
$cc->{$l}[$n][1] ||= $uc->{$l}[$n][0][1];
}
- # use Data::Dumper; print STDERR Dumper $uc;
- # use Data::Dumper; print STDERR "cc: ", Dumper $cc;
+ # print STDERR Dumper $uc;
+ # print STDERR "cc: ", Dumper $cc;
}
sub add_time
@@ -461,7 +460,6 @@ sub add_time
my $l = $sc->[$i];
unless (defined $l)
{
- # use Data::Dumper;
# print STDERR "sc ", scalar @$sc, ", fc ", scalar @$fc, "\n";
# print STDERR "sc ", Dumper($sc), "fc ", Dumper($fc);
warn "Devel::Cover: ignoring extra statement\n";
@@ -509,8 +507,7 @@ sub add_subroutine
my $self = shift;
my ($cc, $sc, $fc, $uc) = @_;
- # use Data::Dumper;
- # print STDERR "add_subroutine():\n", Dumper $cc, $sc, $fc, $uc;
+ # print STDERR "add_subroutine():\n", Dumper $cc, $sc, $fc, $uc;
# $cc = { line_number => [ [ count, sub_name, uncoverable ], [ ... ] ], .. }
# $sc = [ [ line_number, sub_name ], [ ... ] ]
@@ -524,7 +521,6 @@ sub add_subroutine
my $l = $sc->[$i][0];
unless (defined $l)
{
- # use Data::Dumper;
# print STDERR "sc ", scalar @$sc, ", fc ", scalar @$fc, "\n";
# print STDERR "sc ", Dumper($sc), "fc ", Dumper($fc);
warn "Devel::Cover: ignoring extra subroutine\n";
@@ -581,7 +577,7 @@ sub uncoverable
}
}
- # use Data::Dumper; $Data::Dumper::Indent = 1; print STDERR Dumper $u;
+ # print STDERR Dumper $u;
# Now change the format of the uncoverable information.
for my $file (sort keys %$u)
@@ -603,7 +599,7 @@ sub uncoverable
}
close $fh;
my $f = $u->{$file};
- # use Data::Dumper; $Data::Dumper::Indent = 1; print STDERR Dumper $f;
+ # print STDERR Dumper $f;
for my $crit (keys %$f)
{
my $c = $f->{$crit};
@@ -629,7 +625,7 @@ sub uncoverable
$u->{$df->hexdigest} = delete $u->{$file};
}
- use Data::Dumper; $Data::Dumper::Indent = 1; print STDERR Dumper $u;
+ print STDERR Dumper $u;
$u
}
@@ -678,143 +674,84 @@ sub clean_uncoverable
my $self = shift;
}
-sub cover
+sub uncoverable_comments
{
my $self = shift;
-
- return $self->{cover} if $self->{cover_valid};
-
- my %digests; # mapping of digests to canonical filenames
- my %files; # processed files
- my $cover = $self->{cover} = {};
-
- my $st = Devel::Cover::DB::Structure->new(base => $self->{base})->read_all;
+ my ($uncoverable, $file, $digest) = @_;
my $cr = join "|", @{$self->{all_criteria}};
my $uc = qr/(.*)# uncoverable ($cr)(.*)/; # regex for uncoverable comments
- my %uncoverable;
my %types =
(
branch => { true => 0, false => 1 },
condition => { left => 0, right => 1, false => 2 },
);
- # use Data::Dumper; print STDERR "runs: ", Dumper $self->{runs};
- my @runs;
+ # Look for uncoverable comments
+ open my $fh, "<", $file or do
{
- no warnings "numeric";
- # TODO - change sort order
- @runs = sort { $b <=> $a } keys %{$self->{runs}};
- }
-
- for my $run (@runs)
+ warn "Devel::Cover: Can't open file $file: $!\n";
+ next;
+ };
+ my @waiting;
+ while (<$fh>)
{
- last unless $st;
-
- my $r = $self->{runs}{$run};
- @{$self->{collected}}{@{$r->{collected}}} = ();
- $st->add_criteria(@{$r->{collected}});
- my $count = $r->{count};
- # use Data::Dumper; print STDERR "run $run, count: ", Dumper $count;
- while (my ($file, $f) = each %$count)
+ chomp;
+ # print STDERR "read [$.][$_]\n";
+ next unless /$uc/ || @waiting;
+ if ($2)
{
- my $digest = $r->{digests}{$file};
- unless ($digest)
- {
- print STDERR "Devel::Cover: Can't find digest for $file\n";
- next;
- }
- # print STDERR "File: $file\n";
- print STDERR "Devel::Cover: merging data for $file ",
- "into $digests{$digest}\n"
- if !$files{$file}++ && $digests{$digest};
+ my ($code, $criterion, $info) = ($1, $2, $3);
+ my ($count, $class, $note, $type) = (1, "default", "");
- # Set up data structure to hold coverage being filled in
- my $cf = $cover->{$digests{$digest} ||= $file} ||= {};
-
- # Look for uncoverable comments
- open my $fh, "<", $file or do
- {
- warn "Devel::Cover: Can't open file $file: $!\n";
- next;
- };
- my @waiting;
- while (<$fh>)
+ if ($criterion eq "branch" || $criterion eq "condition")
{
- chomp;
- # print STDERR "read [$.][$_]\n";
- next unless /$uc/ || @waiting;
- if ($2)
+ if ($info =~ /^\s*(\w+)(?:\s|$)/)
{
- my ($code, $criterion, $info) = ($1, $2, $3);
- my ($count, $class, $note, $type) = (1, "default", "");
-
- if ($criterion eq "branch" || $criterion eq "condition")
+ my $t = $1;
+ $type = $types{$criterion}{$t};
+ unless (defined $type)
{
- if ($info =~ /^\s*(\w+)(?:\s|$)/)
- {
- my $t = $1;
- $type = $types{$criterion}{$t};
- unless (defined $type)
- {
- warn "Unknown type $t found parsing " .
- "uncoverable $criterion at $file:$.\n";
- $type = 999; # partly magic number
- }
- }
+ warn "Unknown type $t found parsing " .
+ "uncoverable $criterion at $file:$.\n";
+ $type = 999; # partly magic number
}
- $count = $1 if $info =~ /count:(\d+)/;
- $class = $1 if $info =~ /class:(\w+)/;
- $note = $1 if $info =~ /note:(.+)/;
-
- # no warnings "uninitialized";
- # warn "pushing $criterion, $count, $type, $class, $note";
-
- push @waiting,
- [$criterion, $count - 1, $type, $class, $note];
-
- next unless $code =~ /\S/;
- }
-
- # found what we are waiting for
- while (my $w = shift @waiting)
- {
- my ($criterion, $count, $type, $class, $note) = @$w;
- push @{$uncoverable{$digest}{$criterion}{$.}[$count]},
- [$type, $class, $note];
}
}
- close $fh;
+ $count = $1 if $info =~ /count:(\d+)/;
+ $class = $1 if $info =~ /class:(\w+)/;
+ $note = $1 if $info =~ /note:(.+)/;
- warn scalar @waiting,
- " unmatched uncoverable comments not found at end of $file\n"
- if @waiting;
+ # no warnings "uninitialized";
+ # warn "pushing $criterion, $count, $type, $class, $note";
- # TODO - read in and merge $self->uncoverable;
- # use Data::Dumper; print Dumper \%uncoverable;
+ push @waiting,
+ [$criterion, $count - 1, $type, $class, $note];
- # print STDERR "st ", Dumper($st),
- # "f ", Dumper($f),
- # "uc ", Dumper($uncoverable{$digest});
- while (my ($criterion, $fc) = each %$f)
- {
- my $get = "get_$criterion";
- my $sc = $st->$get($digests{$digest});
- # print STDERR "$criterion: ", Dumper $sc, $fc;
- next unless $sc; # TODO - why?
- my $cc = $cf->{$criterion} ||= {};
- my $add = "add_$criterion";
- # print STDERR "$add():\n", Dumper $cc, $sc, $fc;
- $self->$add($cc, $sc, $fc, $uncoverable{$digest}{$criterion});
- # print STDERR "--> $add():\n", Dumper $cc;
- # $cc - coverage being filled in
- # $sc - structure information
- # $fc - coverage from this file
- # $uc - uncoverable information
- }
+ next unless $code =~ /\S/;
+ }
+
+ # found what we are waiting for
+ while (my $w = shift @waiting)
+ {
+ my ($criterion, $count, $type, $class, $note) = @$w;
+ push @{$uncoverable->{$digest}{$criterion}{$.}[$count]},
+ [$type, $class, $note];
}
- # print STDERR "Cover: ", Dumper $cover;
}
+ close $fh;
+
+ warn scalar @waiting,
+ " unmatched uncoverable comments not found at end of $file\n"
+ if @waiting;
+
+ # TODO - read in and merge $self->uncoverable;
+ # print Dumper $uncoverable;
+}
+
+sub objectify_cover
+{
+ my $self = shift;
unless (UNIVERSAL::isa($self->{cover}, "Devel::Cover::DB::Cover"))
{
@@ -900,7 +837,80 @@ sub cover
};
}
}
+}
+
+sub cover
+{
+ my $self = shift;
+
+ return $self->{cover} if $self->{cover_valid};
+
+ my %digests; # mapping of digests to canonical filenames
+ my %files; # processed files
+ my $cover = $self->{cover} = {};
+ my $uncoverable = {};
+ my $st = Devel::Cover::DB::Structure->new(base => $self->{base})->read_all;
+ my @runs = sort { $self->{runs}{$b}{start} <=> $self->{runs}{$a}{start} }
+ keys %{$self->{runs}};
+ # print STDERR "runs: ", Dumper $self->{runs};
+
+ for my $run (@runs)
+ {
+ last unless $st;
+
+ my $r = $self->{runs}{$run};
+ @{$self->{collected}}{@{$r->{collected}}} = ();
+ $st->add_criteria(@{$r->{collected}});
+ my $count = $r->{count};
+ # print STDERR "run $run, count: ", Dumper $count;
+ while (my ($file, $f) = each %$count)
+ {
+ my $digest = $r->{digests}{$file};
+ unless ($digest)
+ {
+ print STDERR "Devel::Cover: Can't find digest for $file\n";
+ next;
+ }
+ # print STDERR "File: $file\n";
+ print STDERR "Devel::Cover: merging data for $file ",
+ "into $digests{$digest}\n"
+ if !$files{$file}++ && $digests{$digest};
+
+ $self->uncoverable_comments($uncoverable, $file, $digest)
+ unless $digests{$digest};
+
+ # Set up data structure to hold coverage being filled in
+ my $cf = $cover->{$digests{$digest} ||= $file} ||= {};
+
+ # print STDERR "st ", Dumper($st),
+ # "f ", Dumper($f),
+ # "uc ", Dumper($uncoverable->{$digest});
+ while (my ($criterion, $fc) = each %$f)
+ {
+ my $get = "get_$criterion";
+ my $sc = $st->$get($digest);
+ # print STDERR "$criterion: ", Dumper $sc, $fc;
+ unless ($sc)
+ {
+ print STDERR "Devel::Cover: Can't locate structure for ",
+ "$criterion in $file\n";
+ next;
+ }
+ my $cc = $cf->{$criterion} ||= {};
+ my $add = "add_$criterion";
+ # print STDERR "$add():\n", Dumper $cc, $sc, $fc;
+ $self->$add($cc, $sc, $fc, $uncoverable->{$digest}{$criterion});
+ # print STDERR "--> $add():\n", Dumper $cc;
+ # $cc - coverage being filled in
+ # $sc - structure information
+ # $fc - coverage from this file
+ # $uc - uncoverable information
+ }
+ }
+ # print STDERR "Cover: ", Dumper $cover;
+ }
+ $self->objectify_cover;
$self->{cover_valid} = 1;
$self->{cover}
}
@@ -1007,7 +1017,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -12,7 +12,9 @@ require 5.8.0; # My patches to B::Concise didn't get released till 5.8.0.
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
+
+use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1;
use Devel::Cover qw( -ignore blib -ignore \\wB\\w );
use B::Concise qw( set_style add_callback );
@@ -58,7 +60,6 @@ sub import
{
my ($h, $op, $format, $level) = @_;
my $key = Devel::Cover::get_key($op);
- # use Data::Dumper; $Data::Dumper::Indent = 1;
# print Dumper Devel::Cover::coverage unless $d++;
if ($h->{seq})
{
@@ -112,7 +113,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Pod;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Criterion";
@@ -66,7 +66,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -18,9 +18,9 @@ package Devel::Cover::Report::Compilation;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::DB 0.76;
+use Devel::Cover::DB 0.77;
# TODO - uncoverable code?
@@ -169,7 +169,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Report::Html;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Report::Html_minimal";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,10 +10,10 @@ package Devel::Cover::Report::Html_basic;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::DB 0.76;
-use Devel::Cover::Web 0.76 "write_file";
+use Devel::Cover::DB 0.77;
+use Devel::Cover::Web 0.77 "write_file";
use Getopt::Long;
use Template 2.00;
@@ -449,7 +449,7 @@ package Devel::Cover::Report::Html_basic::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Template::Provider";
@@ -469,7 +469,7 @@ $Templates{html} = <<'EOT';
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<!--
-This file was generated by Devel::Cover Version 0.76
+This file was generated by Devel::Cover Version 0.77
Devel::Cover is copyright 2001-2011, Paul Johnson (pjcj@cpan.org)
Devel::Cover is free. It is licensed under the same terms as Perl itself.
The latest version of Devel::Cover should be available from my homepage:
@@ -770,7 +770,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -4,10 +4,10 @@ use strict;
use warnings;
use CGI;
use Getopt::Long;
-use Devel::Cover::DB 0.76;
-use Devel::Cover::Truth_Table 0.76;
+use Devel::Cover::DB 0.77;
+use Devel::Cover::Truth_Table 0.77;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
#-------------------------------------------------------------------------------
# Subroutine : get_coverage_for_line
@@ -261,7 +261,7 @@ sub print_html_header {
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<!--
-This file was generated by Devel::Cover Version 0.76
+This file was generated by Devel::Cover Version 0.77
Devel::Cover is copyright 2001-2011, Paul Johnson (pjcj\@cpan.org)
Devel::Cover is free. It is licensed under the same terms as Perl itself.
The latest version of Devel::Cover should be available from my homepage:
@@ -776,7 +776,7 @@ Devel::Cover
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -2,10 +2,10 @@ package Devel::Cover::Report::Html_subtle;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::DB 0.76;
-use Devel::Cover::Truth_Table 0.76;
+use Devel::Cover::DB 0.77;
+use Devel::Cover::Truth_Table 0.77;
use Template 2.00;
use CGI;
@@ -386,7 +386,7 @@ package Devel::Cover::Report::Html_subtle::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Template::Provider";
@@ -404,7 +404,7 @@ sub fetch {
$Templates{html} = <<'EOT';
<?xml version="1.0" encoding="utf-8"?>
<!--
-This file was generated by Devel::Cover Version 0.76
+This file was generated by Devel::Cover Version 0.77
Devel::Cover is copyright 2001-2011, Paul Johnson (pjcj\@cpan.org)
Devel::Cover is free. It is licensed under the same terms as Perl itself.
The latest version of Devel::Cover should be available from my homepage:
@@ -728,7 +728,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,9 +10,9 @@ package Devel::Cover::Report::Sort;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::DB 0.76;
+use Devel::Cover::DB 0.77;
sub print_sort
{
@@ -95,7 +95,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,9 +10,9 @@ package Devel::Cover::Report::Text;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::DB 0.76;
+use Devel::Cover::DB 0.77;
sub print_runs
{
@@ -313,7 +313,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -2,9 +2,9 @@ package Devel::Cover::Report::Text2;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
-use Devel::Cover::DB 0.76;
+use Devel::Cover::DB 0.77;
use Devel::Cover::Truth_Table;
my %format = (
@@ -191,7 +191,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Statement;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Criterion";
@@ -51,7 +51,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,7 +10,7 @@ package Devel::Cover::Subroutine;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Criterion";
@@ -50,7 +50,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,14 +10,14 @@ package Devel::Cover::Test;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use Carp;
use File::Spec;
use Test;
-use Devel::Cover::Inc 0.76;
+use Devel::Cover::Inc 0.77;
my $Test;
@@ -10,7 +10,7 @@ package Devel::Cover::Time;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use base "Devel::Cover::Criterion";
@@ -71,7 +71,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -180,7 +180,7 @@ sub error {
package Devel::Cover::Truth_Table;
use warnings;
use strict;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
#-------------------------------------------------------------------------------
# Subroutine : new()
@@ -567,7 +567,7 @@ None that I'm aware of...
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENSE
@@ -163,7 +163,7 @@ basis for future research.
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -12,7 +12,7 @@ package Devel::Cover::Web;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use Exporter;
@@ -934,7 +934,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -10,13 +10,14 @@ package Devel::Cover;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use DynaLoader ();
our @ISA = "DynaLoader";
-use Devel::Cover::DB 0.76;
-use Devel::Cover::Inc 0.76;
+use Devel::Cover::DB 0.77;
+use Devel::Cover::DB::Digests 0.77;
+use Devel::Cover::Inc 0.77;
use B qw( class ppname main_cv main_start main_root walksymtable OPf_KIDS );
use B::Debug;
@@ -27,6 +28,8 @@ use Config;
use Cwd "abs_path";
use File::Spec;
+use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1;
+
BEGIN
{
# Use Pod::Coverage if it is available.
@@ -72,6 +75,7 @@ my $Sub_count; # Count for multiple subs on same line.
my $Coverage; # Raw coverage data.
my $Structure; # Structure of the files.
+my $Digests; # Digests of the files.
my %Criteria; # Names of coverage criteria.
my %Coverage; # Coverage criteria to collect.
@@ -296,6 +300,13 @@ sub import
warn __PACKAGE__ . ": Unknown option $_ ignored\n";
}
+ if ($blib)
+ {
+ eval "use blib";
+ for (@INC) { $_ = $1 if /(.*)/ } # Die tainting.
+ push @Ignore, "^t/", '\\.t$', '^test\\.pl$';
+ }
+
my $ci = $^O eq "MSWin32";
@Select_re = map qr/$_/, @Select;
@Ignore_re = map qr/$_/, @Ignore;
@@ -323,14 +334,7 @@ sub import
$DB = $1 if abs_path($DB) =~ /(.*)/;
Devel::Cover::DB->delete($DB) unless $Merge;
- if ($blib)
- {
- eval "use blib";
- for (@INC) { $_ = $1 if /(.*)/ } # Die tainting.
- push @Ignore, "^t/", '\\.t$', '^test\\.pl$';
- }
-
- %Files = (); # start gathering file information from scratch
+ %Files = (); # start gathering file information from scratch
for my $c (Devel::Cover::DB->new->criteria)
{
@@ -415,16 +419,22 @@ sub get_coverage
my %File_cache;
+# Recursion in normalised_file() is bad. It can happen if a call from the sub
+# evals something which wants to load a new module. This has happened with
+# the Storable backend. I don't think it happens with the JSON backend.
+my $Normalising;
+
sub normalised_file
{
my ($file) = @_;
return $File_cache{$file} if exists $File_cache{$file};
+ return $file if $Normalising;
+ $Normalising = 1;
my $f = $file;
$file =~ s/ \(autosplit into .*\)$//;
- # print STDERR "file is <$file>\n";
- # use Data::Dumper;
+ $file =~ s/^\(eval in .*\) //;
# print STDERR "file is <$file>\ncoverage: ", Dumper coverage(0);
if (exists coverage(0)->{module} && exists coverage(0)->{module}{$file} &&
!File::Spec->file_name_is_absolute($file))
@@ -461,8 +471,12 @@ sub normalised_file
$file =~ s|\\|/|g if $^O eq "MSWin32";
$file =~ s|^$Dir/|| if defined $Dir;
+ $Digests ||= Devel::Cover::DB::Digests->new(db => $DB);
+ $file = $Digests->canonical_file($file);
+
# print STDERR "File: $f => $file\n";
+ $Normalising = 0;
$File_cache{$f} = $file
}
@@ -499,6 +513,7 @@ sub use_file
# die "bad file" unless length $file;
$file = $1 if $file =~ /^\(eval \d+\)\[(.+):\d+\]/;
+ $file = $1 if $file =~ /^\(eval in \w+\) (.+)/;
$file =~ s/ \(autosplit into .*\)$//;
return $Files{$file} if exists $Files{$file};
@@ -651,12 +666,11 @@ sub _report
$Structure = Devel::Cover::DB::Structure->new(base => $DB);
$Structure->read_all;
$Structure->add_criteria(@collected);
- # use Data::Dumper; $Data::Dumper::Indent = 1;
- # use Data::Dumper; print STDERR "Start structure: ", Dumper $Structure;
+ # print STDERR "Start structure: ", Dumper $Structure;
# print STDERR "Processing cover data\n@Inc\n";
$Coverage = coverage(1) || die "No coverage data available.\n";
- # use Data::Dumper; print STDERR Dumper $Coverage;
+ # print STDERR Dumper $Coverage;
check_files();
@@ -701,7 +715,7 @@ sub _report
$Structure->store_counts($file);
}
- # use Data::Dumper; print STDERR "End structure: ", Dumper $Structure;
+ # print STDERR "End structure: ", Dumper $Structure;
my $run = time . ".$$." . sprintf "%05d", rand 2 ** 16;
my $cover = Devel::Cover::DB->new
@@ -721,6 +735,7 @@ sub _report
print OUT __PACKAGE__, ": Writing coverage database to $dbrun\n"
unless $Silent;
$cover->write($dbrun);
+ $Digests->write;
$cover->print_summary if $Summary && !$Silent;
return if !$Self_cover || $Self_cover_run;
@@ -1169,7 +1184,7 @@ sub get_cover
}
}
$Pod = "Pod::Coverage" if delete $opts{nocp};
- # use Data::Dumper; print STDERR "$Pod, ", Dumper \%opts;
+ # print STDERR "$Pod, ", Dumper \%opts;
if ($Pod{$file} ||= $Pod->new(package => $pkg, %opts))
{
my $covered;
@@ -1502,7 +1517,7 @@ See the BUGS file. And the TODO file.
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+if ($] < 5.008000)
+{
+ plan skip_all => "Test requires perl 5.8.0 or greater";
+}
+else
+{
+ plan tests => 2;
+}
+
+my $cmd = "$^X -e 'print \"Hello World.\\n\"'";
+my $output = `$cmd 2>&1`;
+is($output, "Hello World.\n", 'simple test with perl -e');
+
+$cmd = "$^X -Mblib -MDevel::Cover=-silent,1 -e 'print \"Hello World.\\n\"'";
+$output = `$cmd 2>&1`;
+is($output, "Hello World.\n", 'test with perl -MDevel::Cover,-silent,1 -e');
@@ -20,25 +20,35 @@ tests/inc_sub
line err stmt bran cond sub code
1 #!/bin/perl
2
-3 use lib ();
+3 # Copyright 2002-2011, Paul Johnson (pjcj@cpan.org)
4
-5 BEGIN
-6 {
-7 lib->import
-8 (
-9 sub
-10 {
-11 print map("[$_]", @_), "\n";
-12 return unless $_[1] eq "IncSub.pm";
-13 my $fh;
-14 open $fh, "tests/IncSub.pm" or die $!;
-15 $fh
-16 }
-17 )
-18 }
-19
-20 use IncSub;
-21
-22 1 IncSub::check
+5 # This software is free. It is licensed under the same terms as Perl itself.
+6
+7 # The latest version of this software should be available from my homepage:
+8 # http://www.pjcj.net
+9
+10 # __COVER__ changes s/(2[12] )[23]/$1X/
+11 # __COVER__ changes s/(22 100 )[12]/$1X/
+12
+13 use lib ();
+14
+15 BEGIN
+16 {
+17 lib->import
+18 (
+19 sub
+20 {
+21 print map("[$_]", @_), "\n";
+22 return unless $_[1] eq "IncSub.pm";
+23 my $fh;
+24 open $fh, "tests/IncSub.pm" or die $!;
+25 $fh
+26 }
+27 )
+28 }
+29
+30 use IncSub;
+31
+32 1 IncSub::check
@@ -20,30 +20,40 @@ tests/inc_sub
line err stmt bran cond sub code
1 #!/bin/perl
2
-3 1 1 use lib ();
+3 # Copyright 2002-2011, Paul Johnson (pjcj@cpan.org)
+4
+5 # This software is free. It is licensed under the same terms as Perl itself.
+6
+7 # The latest version of this software should be available from my homepage:
+8 # http://www.pjcj.net
+9
+10 # __COVER__ changes s/(2[12] )[23]/$1X/
+11 # __COVER__ changes s/(22 100 )[12]/$1X/
+12
+13 1 1 use lib ();
1
1
-4
-5 BEGIN
-6 {
-7 lib->import
-8 (
-9 sub
-10 {
-11 1 print map("[$_]", @_), "\n";
-12 *** 1 50 return unless $_[1] eq "IncSub.pm";
-13 1 my $fh;
-14 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
-15 1 $fh
-16 }
-17 )
-18 1 1 }
-19
-20 1 1 use IncSub;
+14
+15 BEGIN
+16 {
+17 lib->import
+18 (
+19 sub
+20 {
+21 1 print map("[$_]", @_), "\n";
+22 *** 1 50 return unless $_[1] eq "IncSub.pm";
+23 1 my $fh;
+24 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
+25 1 $fh
+26 }
+27 )
+28 1 1 }
+29
+30 1 1 use IncSub;
1
1
-21
-22 1 IncSub::check
+31
+32 1 IncSub::check
Branches
@@ -51,8 +61,8 @@ Branches
line err % true false branch
----- --- ------ ------ ------ ------
-12 *** 50 0 1 unless $_[1] eq 'IncSub.pm'
-14 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
+22 *** 50 0 1 unless $_[1] eq 'IncSub.pm'
+24 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
Covered Subroutines
@@ -60,8 +70,8 @@ Covered Subroutines
Subroutine Count Location
---------- ----- ----------------
-BEGIN 1 tests/inc_sub:18
-BEGIN 1 tests/inc_sub:20
-BEGIN 1 tests/inc_sub:3
+BEGIN 1 tests/inc_sub:13
+BEGIN 1 tests/inc_sub:28
+BEGIN 1 tests/inc_sub:30
@@ -20,30 +20,40 @@ tests/inc_sub
line err stmt bran cond sub code
1 #!/bin/perl
2
-3 1 1 use lib ();
+3 # Copyright 2002-2011, Paul Johnson (pjcj@cpan.org)
+4
+5 # This software is free. It is licensed under the same terms as Perl itself.
+6
+7 # The latest version of this software should be available from my homepage:
+8 # http://www.pjcj.net
+9
+10 # __COVER__ changes s/(2[12] )[23]/$1X/
+11 # __COVER__ changes s/(22 100 )[12]/$1X/
+12
+13 1 1 use lib ();
1
1
-4
-5 BEGIN
-6 {
-7 lib->import
-8 (
-9 sub
-10 {
-11 2 print map("[$_]", @_), "\n";
-12 2 100 return unless $_[1] eq "IncSub.pm";
-13 1 my $fh;
-14 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
-15 1 $fh
-16 }
-17 )
-18 1 1 }
-19
-20 1 1 use IncSub;
+14
+15 BEGIN
+16 {
+17 lib->import
+18 (
+19 sub
+20 {
+21 3 print map("[$_]", @_), "\n";
+22 3 100 return unless $_[1] eq "IncSub.pm";
+23 1 my $fh;
+24 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
+25 1 $fh
+26 }
+27 )
+28 1 1 }
+29
+30 1 1 use IncSub;
1
1
-21
-22 1 IncSub::check
+31
+32 1 IncSub::check
Branches
@@ -51,8 +61,8 @@ Branches
line err % true false branch
----- --- ------ ------ ------ ------
-12 100 1 1 unless $_[1] eq 'IncSub.pm'
-14 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
+22 100 2 1 unless $_[1] eq 'IncSub.pm'
+24 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
Covered Subroutines
@@ -60,8 +70,8 @@ Covered Subroutines
Subroutine Count Location
---------- ----- ----------------
-BEGIN 1 tests/inc_sub:18
-BEGIN 1 tests/inc_sub:20
-BEGIN 1 tests/inc_sub:3
+BEGIN 1 tests/inc_sub:13
+BEGIN 1 tests/inc_sub:28
+BEGIN 1 tests/inc_sub:30
@@ -20,28 +20,38 @@ tests/inc_sub
line err stmt bran cond sub code
1 #!/bin/perl
2
-3 1 1 use lib ();
- 1
+3 # Copyright 2002-2011, Paul Johnson (pjcj@cpan.org)
4
-5 BEGIN
-6 {
-7 lib->import
-8 (
-9 sub
-10 {
-11 2 print map("[$_]", @_), "\n";
-12 2 100 return unless $_[1] eq "IncSub.pm";
-13 1 my $fh;
-14 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
-15 1 $fh
-16 }
-17 )
-18 1 1 }
-19
-20 1 1 use IncSub;
+5 # This software is free. It is licensed under the same terms as Perl itself.
+6
+7 # The latest version of this software should be available from my homepage:
+8 # http://www.pjcj.net
+9
+10 # __COVER__ changes s/(2[12] )[23]/$1X/
+11 # __COVER__ changes s/(22 100 )[12]/$1X/
+12
+13 1 1 use lib ();
+ 1
+14
+15 BEGIN
+16 {
+17 lib->import
+18 (
+19 sub
+20 {
+21 3 print map("[$_]", @_), "\n";
+22 3 100 return unless $_[1] eq "IncSub.pm";
+23 1 my $fh;
+24 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
+25 1 $fh
+26 }
+27 )
+28 1 1 }
+29
+30 1 1 use IncSub;
1
-21
-22 1 IncSub::check
+31
+32 1 IncSub::check
Branches
@@ -49,8 +59,8 @@ Branches
line err % true false branch
----- --- ------ ------ ------ ------
-12 100 1 1 unless $_[1] eq 'IncSub.pm'
-14 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
+22 100 2 1 unless $_[1] eq 'IncSub.pm'
+24 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
Covered Subroutines
@@ -58,8 +68,8 @@ Covered Subroutines
Subroutine Count Location
---------- ----- ----------------
-BEGIN 1 tests/inc_sub:18
-BEGIN 1 tests/inc_sub:20
-BEGIN 1 tests/inc_sub:3
+BEGIN 1 tests/inc_sub:13
+BEGIN 1 tests/inc_sub:28
+BEGIN 1 tests/inc_sub:30
@@ -20,30 +20,40 @@ tests/inc_sub
line err stmt bran cond sub code
1 #!/bin/perl
2
-3 1 1 use lib ();
+3 # Copyright 2002-2011, Paul Johnson (pjcj@cpan.org)
+4
+5 # This software is free. It is licensed under the same terms as Perl itself.
+6
+7 # The latest version of this software should be available from my homepage:
+8 # http://www.pjcj.net
+9
+10 # __COVER__ changes s/(2[12] )[23]/$1X/
+11 # __COVER__ changes s/(22 100 )[12]/$1X/
+12
+13 1 1 use lib ();
1
1
-4
-5 BEGIN
-6 {
-7 lib->import
-8 (
-9 sub
-10 {
-11 2 print map("[$_]", @_), "\n";
-12 2 100 return unless $_[1] eq "IncSub.pm";
-13 1 my $fh;
-14 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
-15 1 $fh
-16 }
-17 )
-18 1 1 }
-19
-20 1 1 use IncSub;
+14
+15 BEGIN
+16 {
+17 lib->import
+18 (
+19 sub
+20 {
+21 3 print map("[$_]", @_), "\n";
+22 3 100 return unless $_[1] eq "IncSub.pm";
+23 1 my $fh;
+24 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
+25 1 $fh
+26 }
+27 )
+28 1 1 }
+29
+30 1 1 use IncSub;
1
1
-21
-22 1 IncSub::check
+31
+32 1 IncSub::check
Branches
@@ -51,8 +61,8 @@ Branches
line err % true false branch
----- --- ------ ------ ------ ------
-12 100 1 1 unless $_[1] eq 'IncSub.pm'
-14 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
+22 100 2 1 unless $_[1] eq 'IncSub.pm'
+24 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
Covered Subroutines
@@ -60,8 +70,8 @@ Covered Subroutines
Subroutine Count Location
---------- ----- ----------------
-BEGIN 1 tests/inc_sub:18
-BEGIN 1 tests/inc_sub:20
-BEGIN 1 tests/inc_sub:3
+BEGIN 1 tests/inc_sub:13
+BEGIN 1 tests/inc_sub:28
+BEGIN 1 tests/inc_sub:30
@@ -20,30 +20,40 @@ tests/inc_sub
line err stmt bran cond sub code
1 #!/bin/perl
2
-3 1 1 use lib ();
+3 # Copyright 2002-2011, Paul Johnson (pjcj@cpan.org)
+4
+5 # This software is free. It is licensed under the same terms as Perl itself.
+6
+7 # The latest version of this software should be available from my homepage:
+8 # http://www.pjcj.net
+9
+10 # __COVER__ changes s/(2[12] )[23]/$1X/
+11 # __COVER__ changes s/(22 100 )[12]/$1X/
+12
+13 1 1 use lib ();
1
1
-4
-5 BEGIN
-6 {
-7 lib->import
-8 (
-9 sub
-10 {
-11 2 print map("[$_]", @_), "\n";
-12 2 100 return unless $_[1] eq "IncSub.pm";
-13 1 my $fh;
-14 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
-15 1 $fh
-16 }
-17 )
-18 1 1 }
-19
-20 1 1 use IncSub;
+14
+15 BEGIN
+16 {
+17 lib->import
+18 (
+19 sub
+20 {
+21 2 print map("[$_]", @_), "\n";
+22 2 100 return unless $_[1] eq "IncSub.pm";
+23 1 my $fh;
+24 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
+25 1 $fh
+26 }
+27 )
+28 1 1 }
+29
+30 1 1 use IncSub;
1
1
-21
-22 1 IncSub::check
+31
+32 1 IncSub::check
Branches
@@ -51,8 +61,8 @@ Branches
line err % true false branch
----- --- ------ ------ ------ ------
-12 100 1 1 unless $_[1] eq 'IncSub.pm'
-14 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
+22 100 1 1 unless $_[1] eq 'IncSub.pm'
+24 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
Covered Subroutines
@@ -60,8 +70,8 @@ Covered Subroutines
Subroutine Count Location
---------- ----- ----------------
-BEGIN 1 tests/inc_sub:18
-BEGIN 1 tests/inc_sub:20
-BEGIN 1 tests/inc_sub:3
+BEGIN 1 tests/inc_sub:13
+BEGIN 1 tests/inc_sub:28
+BEGIN 1 tests/inc_sub:30
@@ -12,8 +12,14 @@ use warnings;
use File::Copy;
-use Devel::Cover::Inc 0.76;
-use Devel::Cover::Test 0.76;
+use Devel::Cover::Inc 0.77;
+use Devel::Cover::Test 0.77;
+
+if ($] == 5.008007)
+{
+ eval "use Test::More skip_all => 'Crashes 5.8.7'";
+ exit;
+}
my $base = $Devel::Cover::Inc::Base;
@@ -10,7 +10,7 @@
use strict;
use warnings;
-use Devel::Cover::Test 0.76;
+use Devel::Cover::Test 0.77;
if ($] == 5.008007)
{
@@ -10,7 +10,7 @@
use strict;
use warnings;
-use Devel::Cover::Test 0.76;
+use Devel::Cover::Test 0.77;
if ($] == 5.008007)
{
@@ -1,5 +1,15 @@
#!/bin/perl
+# Copyright 2002-2011, Paul Johnson (pjcj@cpan.org)
+
+# This software is free. It is licensed under the same terms as Perl itself.
+
+# The latest version of this software should be available from my homepage:
+# http://www.pjcj.net
+
+# __COVER__ changes s/(2[12] )[23]/$1X/
+# __COVER__ changes s/(22 100 )[12]/$1X/
+
use lib ();
BEGIN
@@ -12,8 +12,8 @@ use warnings;
use File::Copy;
-use Devel::Cover::Inc 0.76;
-use Devel::Cover::Test 0.76;
+use Devel::Cover::Inc 0.77;
+use Devel::Cover::Test 0.77;
my $base = $Devel::Cover::Inc::Base;
@@ -10,7 +10,7 @@ package Devel::Cover::BuildUtils;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use Exporter;
@@ -77,7 +77,7 @@ Huh?
=head1 VERSION
-Version 0.76 - 18th April 2011
+Version 0.77 - 15th May 2011
=head1 LICENCE
@@ -40,9 +40,10 @@ sub get_options
[ map { ($_, "$_-thr") }
qw( 5.6.1 5.6.2
5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6 5.8.7 5.8.8 5.8.9
- 5.10.0 5.10.1 5.11.0 5.12.0 5.12.1 5.12.2 5.12.3
- 5.13.0 5.13.1 5.13.2 5.13.3 5.13.4 5.13.5
- 5.13.6 5.13.7 5.13.8 5.13.9 5.13.10 5.13.11 ) ]
+ 5.10.0 5.10.1
+ 5.12.0 5.12.1 5.12.2 5.12.3
+ 5.14.0
+ ) ]
unless @{$Options->{version}};
$Silent = " >/dev/null 2>&1" if $Options->{silent};
$Options->{version} =
@@ -12,14 +12,14 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.76";
+our $VERSION = "0.77";
use blib;
use Config;
exit if $Config{useithreads};
-use Devel::Cover::Test 0.76;
+use Devel::Cover::Test 0.77;
my @tests = @ARGV;